PC Plus SuperCD (UK) 1997 May/PC Plus Super CD Issue 127 (May 1997).iso/delphi1/lesson4/todolist/todo1.pas

Pascal/Delphi Source File | 1996-07-07 | 18.5 KB | 596 lines

unit Todo1;
(* --------------------------------------------------------------
             PC PLUS SAMPLE TODO LIST MANAGER
                WRITTEN IN BORLAND'S DELPHI
                 AUTHOR: HUW COLLINGBOURNE
   --------------------------------------------------------------

   This is a sample application written for a Delphi tutorial series
   in PC Plus (UK) magazine. You may use it or adapt it for your own
   use. You may not sell it. No claims are made for its elegance,
   reliability or suitability for any purpose whatsoever!

   This application illustrates several useful features of Delphi,
   such as:
   - String Lists with associated objects
   - Saving and loading records from disk
   - Using the Calendar object
   - Menus and pop-up menus (right click in ToDo list)
   - Multiple unit projects
   - Standard dialog objects (to save and load files)
   - User-defined dialog boxes
   - ToolTip 'hints' (place mouse pointer over CalendarBtn)
   - Date-Time routines
   - RadioGroup objects

   --------------------------------------------------------------
      TO USE THE TODO LIST:
   --------------------------------------------------------------
      *  Enter an item into the text entry box, click a Priority in the radio
         button group, pick a date by clicking the button next to the Date
         Due box. Click Add.

      *  You can also delete items or you can change an item's text,
         date or priority and save the changes by clicking Replace.

      *  To edit an item, double-click it.

      *  For mouse shortcuts, single-click the ToDo box with the
         right mouse button.

      *  To view an item's associated date and priority (shown in the
         date entry box and the Priority radio group box), single-click
         the item. The Priority Radio Group and the date box display
         the data associated with that item.

      *  To have the items sorted (continuously) use the Sorting radio
         button box or the mouse menu.


--------------------------------------------------------------
   POSSIBLE FUTURE ADDITIONS TO THE APPLICATION:
--------------------------------------------------------------

   There are plenty of other features which you might like
   to add to (or change in) this application such as:
   - i/o checking (if you try to save to an empty disk drive, say)
   - error recovery (if you try to load the wrong file type)
   - an option to display dates and priorities alongside each item (maybe
     in another list box?)
   - improved sorting speed by assigning the ToDolist items to a non-visual
     TStrings object prior to sorting.
   - make the ConfirmFileSave function a Form method: TToDoForm.ConfirmFileSave
   - attach free-form memos to items etc. etc...
   These topics have been discussed during the course of the
   tutorial, so go ahead, give it a go!

*)


interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls,
  StrUtils, Menus, Calend1, SaveMess ;
type
  sortType = set of (bydate, bypriority);
type
  TToDoForm = class(TForm)
    ToDoList: TListBox;
    InputLine: TEdit;
    AddBtn: TButton;
    RadioGroupPriority: TRadioGroup;
    DateDueEditBox: TEdit;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    SaveMnu: TMenuItem;
    SaveAsMnu: TMenuItem;
    LoadMnu: TMenuItem;
    ExitMnu: TMenuItem;
    NewMnu: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    RadioGroupSetSort: TRadioGroup;
    DelBtn: TButton;
    ReplaceBtn: TButton;
    PopupMenu1: TPopupMenu;
    Add1: TMenuItem;
    Delete1: TMenuItem;
    Replace1: TMenuItem;
    SortBy1: TMenuItem;
    Name1: TMenuItem;
    Priority1: TMenuItem;
    Date1: TMenuItem;
    Unsorted1: TMenuItem;
    CalendarBtn: TButton;
    Panel1: TPanel;
    ExitBtn: TButton;
    DueByLabel: TLabel;
    Panel2: TPanel;
    procedure AddBtnClick(Sender: TObject);
    procedure ExitMnuClick(Sender: TObject);
    procedure LoadMnuClick(Sender: TObject);
    procedure SaveAsMnuClick(Sender: TObject);
    procedure SaveMnuClick(Sender: TObject);
    procedure NewMnuClick(Sender: TObject);
    procedure RadioGroupSetSortClick(Sender: TObject);
    procedure RadioGroupPriorityClick(Sender: TObject);
    procedure ToDoListDblClick(Sender: TObject);
    procedure ToDoListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DelBtnClick(Sender: TObject);
    procedure ReplaceBtnClick(Sender: TObject);
    procedure SortList( Sender: TObject );
    procedure Add1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure Replace1Click(Sender: TObject);
    procedure Name1Click(Sender: TObject);
    procedure Priority1Click(Sender: TObject);
    procedure Date1Click(Sender: TObject);
    procedure Unsorted1Click(Sender: TObject);
    procedure CalendarBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
  private
    { If an item is added or deleted - the Changed state becomes true       }
    { It is unchanged (Changed is false) after file loading, saving, File   }
    { New and when the ToDo form is first loaded.                           }
    Changed : boolean;
    function OKToClearToDoList( Sender : TObject ) : boolean;
    procedure SetChanged( Sender : TObject ;  status : boolean );
    function IsChanged( Sender : TObject ) : boolean;
    procedure SaveItemsToFile(Sender: TObject ; FileName : string );
    function  SaveChangesDlg(Sender: TObject ) : Word;
  public
    { Public declarations }
  end;

var
  ToDoForm: TToDoForm;

type

{ CLASS: ToDoItem }
{ objects of this type provide the associated due-by date and priority for
  the strings with which they are associated in the ToDo list.
  Note: the data access methods aren't really needed in this program
  as it stands. After all, you could just as well write: priority := 1
  rather than PutPriority(1) - However, it's good OOP style to use
  such methods and you'll need to be happy with this type of programming if
  you ever plan to write your own visual components in the commercial
  version of Delphi }

 ToDoItem = class(TObject)
  priority : integer;
  datedue : TDateTime;
  { These are the data access methods }
  procedure PutPriority( a_priority : integer );
  function GetPriority : integer;
  procedure PutDateDue( a_date : TDateTime );
  function GetDateDue : TDateTime;
end;


{ RECORD: ToDoRec }
{ Records are used for file save/load operations. Although it is possible
  to save Objects to disk, this is a complex procedure. It is very much
  simpler to map the object's internal fields (plus its associated string)
  onto a compatible record and use standard file handling routines for
  saving and loading }
type ToDoRecord = record
  str : string;
  priority : integer;
  datedue : TDateTime;
end;


implementation
{$R *.DFM}

function ConfirmFileSave(FileName : string) : boolean;
{ put up a dialog box to confirm that the existing file should be
  overwritten. This function returns True if the Yes button is pressed,
  otherwise it returns false. Note that you can test for the
  buttons used in dialogs with these constants: mrNone,mrOk,mrCancel,
  mrAbort,mrRetry,mrIgnore,mrYes,mrNo,mrAbort,mrRetry,mrIgnore,mrAll }
begin
    if MessageDlg(FileName + ' already exists. Save anyway?',
                        mtConfirmation, mbYesNoCancel, 0)
                        = mrYes then
      ConfirmFileSave := true
    else
      ConfirmFileSave := false;
end;

{ ----------------- }
{ ToDoItem methods  }
{ ----------------- }

procedure ToDoItem.PutPriority( a_priority : integer );
begin
  priority := a_priority;
end;

function ToDoItem.GetPriority : integer;
begin
  GetPriority := priority;
end;

procedure ToDoItem.PutDateDue( a_date : TDateTime );
begin
  datedue := a_date;
end;

function ToDoItem.GetDateDue : TDateTime;
begin
  GetDateDue := datedue;
end;

{ ----------------- }
{ TToDoForm methods }
{ ----------------- }
function TToDoForm.OKToClearToDoList( Sender : TObject ) : boolean;
{ Returns a true or false value to indicate whether or not it is OK
  to clear the ToDo list (say when File/New or File/Load has been
  selected. Give the user the chance to save ToDo list if necessary. }
var
  saveNow : Word;      { does user want to save to disk? Yes/No/Cancel }
  Continue : boolean;  { carry on and clear the ToDo list? Yes/No      }
begin
     { mrNo, mrYes and mrCancel are constants returned by dialog boxes }
    saveNow := mrNo;
    Continue := true;
       { if changes have been made to the ToDo list since the last
         file save operation, then prompt to save the ToDo list    }
    if IsChanged(Sender) then
       saveNow := SaveChangesDlg( Sender );
       { if user wants to save changes, do so }
    if (saveNow = mrYes) then SaveMnuClick(Sender);
    if (saveNow = mrCancel) then Continue := false
    else
        { if user said Yes to save the file but then cancelled the
          SaveAs operation (so the Changed state is still true)
          then return False - i.e. don't clear the ToDo list }
    if (saveNow = mrYes) and IsChanged(Sender) then Continue := false;
    OKToClearToDoList := Continue;
end;

function  TToDoForm.SaveChangesDlg(Sender: TObject ) : Word;
{ show dialog - return a constant, mrYes, mrNo, mrCancel }
begin
  SaveChangesDlg := MessageDlg('Save Changes?',
    mtInformation, [mbYes, mbNo, mbCancel], 0);
end;


procedure TToDoForm.SetChanged( Sender : TObject ;  status : boolean );
begin
  Changed := status;
end;

function TToDoForm.IsChanged( Sender : TObject ) : boolean;
begin
  IsChanged := Changed;
end;

procedure TToDoForm.SortList( Sender: TObject );
{ A Bubble sort - not particulary efficient but has the benefit that,
  as sorting algorithms go, it's fairly simple to understand (honest!) }
var
  i, j  : integer;
  tdi   : ToDoItem;
  count : integer;
begin
  ToDoList.Sorted := False;
  ToDoList.Hide; { Hide for speed up updating }
  count := ToDoList.Items.Count;
  for i := 1 to count do
  begin
    for j := count-1 downto i do
      Case( RadioGroupSetSort.ItemIndex ) of
       2: { sort by: priority }
       if ToDoItem(ToDoList.Items.Objects[j-1]).GetPriority >
         ToDoItem(ToDoList.Items.Objects[j]).GetPriority then
         ToDoList.Items.Exchange(j-1, j);
       3: { sort by: date }
       if ToDoItem(ToDoList.Items.Objects[j-1]).GetDateDue >
         ToDoItem(ToDoList.Items.Objects[j]).GetDateDue then
         ToDoList.Items.Exchange(j-1, j);
      end; { case }
    end;
    ToDoList.Show;
end;



{ ---------------- }
{ Main Menu Items  }
{ ---------------- }
procedure TToDoForm.ExitMnuClick(Sender: TObject);
begin
  if OKToClearToDoList(Sender) then Close;
end;

procedure TToDoForm.LoadMnuClick(Sender: TObject);
{ Read set of ToDo records from disk }
var
   ToDoFile : file of ToDoRecord;
   anItem : ToDoRecord;
   tdi : ToDoItem;
begin
 if OKToClearToDoList(Sender) then
 begin
   with OpenDialog1 do
     if Execute then
     begin
         ToDoList.Clear;
         InputLine.Text := '';
         { if the specified file exists it loads it, otherwise
         it displays an error message }
       if FileExists(FileName) Then
       begin
         AssignFile(ToDoFile, FileName); { File selected in dialog }
         Reset(ToDoFile);
         while not eof(ToDoFile) do
         begin
           Read(ToDoFile, anItem);  { Read a ToDoRecord record out of the file }
           tdi := ToDoItem.Create;  { map its data onto a ToDoItem object      }
           tdi.PutPriority(anItem.priority);
           tdi.PutDatedue(anitem.datedue);
           ToDoList.Items.AddObject(anItem.str, tdi);
         end;
         CloseFile(ToDoFile);
         Caption := ExtractFilename(FileName);
         SetChanged(Sender,false);
           { use current sort order on newly loaded list }
         RadioGroupSetSortClick(Sender);
       end
       else
         MessageDlg('Sorry. Can''t load this file. '+ FileName +
                            ' does not exist!',
                         mtInformation, [mbOK], 0);
     end; { if Execute }
   end;
end;

procedure TToDoForm.SaveItemsToFile(Sender: TObject; FileName : string );
{ Saves ToDoItem objects in the form of ToDoRecords to a file }
var
  F : file of ToDoRecord;
  i : integer;
  tdrec : ToDoRecord;
begin
   AssignFile(F, FileName );
   Rewrite(F);
   For i := 0 To ToDoList.Items.Count-1 do
   begin
         { map ob onto record }
     tdrec.str :=  ToDoList.Items.Strings[i];
     tdrec.priority := ToDoItem(ToDoList.Items.Objects[i]).GetPriority;
     tdrec.datedue := ToDoItem(ToDoList.Items.Objects[i]).GetDatedue;
     Write(F, Tdrec );
   end;
    CloseFile(F);
    SaveMsg.MsgLabel.Caption := '   Saving '+ExtractFileName(FileName)+'   ';
    SaveMsg.ShowModal;
end;


procedure TToDoForm.SaveAsMnuClick(Sender: TObject);
var
   SaveFile : boolean;
begin
  SaveFile := true;
   with SaveDialog1 do
    if Execute then
    begin
      if FileExists(FileName) then
         SaveFile := ConfirmFileSave(FileName);
      if SaveFile then
      begin
         SaveItemsToFile(Sender, FileName );
         Caption := ExtractFilename(FileName);
         OpenDialog1.Filename := Filename;
         SetChanged( Sender, false );
      end;
    end;
end;

procedure TToDoForm.SaveMnuClick(Sender: TObject);
begin
if (OpenDialog1.Filename <> '') and (pos('*',OpenDialog1.Filename) = 0) then
                                     { e.g. the wildcard '*.tdo' }
  begin
    SaveItemsToFile(Sender, OpenDialog1.FileName);
    SetChanged( Sender, false );
  end
  else SaveAsMnuClick(Sender);
end;

procedure TToDoForm.NewMnuClick(Sender: TObject);
begin
   if OKToClearToDoList(Sender) then
   begin
      ToDoList.Clear;
      InputLine.Text := '';
      OpenDialog1.Filename := '*.tdo';
      Caption := 'ToDo - [Untitled]';
      SetChanged( Sender, false );
    end;
end;

{ ------------ }
{ Radio Groups }
{ ------------ }
procedure TToDoForm.RadioGroupSetSortClick(Sender: TObject);
var
  i : integer;
begin
  Case( RadioGroupSetSort.ItemIndex ) of
     0 : { Unsorted } ToDoList.Sorted := False;
     1 : { Name } ToDoList.Sorted := True;
     2,3 : { Priority or Date }  SortList(Sender);
  end;
  ActiveControl := InputLine;
end;

procedure TToDoForm.RadioGroupPriorityClick(Sender: TObject);
{ return focus to input line }
begin
  ActiveControl := InputLine;
end;



{ ---------------------- }
{ ToDo List events       }
{ ---------------------- }
procedure TToDoForm.ToDoListClick(Sender: TObject);
{ when item in list is single clicked, show its date due and its
  priority in the appropriate edit and radio-button boxes }
begin
  DateDueEditBox.Text :=
       DateToStr(ToDoItem(
                 ToDoList.Items.Objects[ToDoList.ItemIndex]).GetDatedue);
  RadioGroupPriority.ItemIndex :=
       ToDoItem(ToDoList.Items.Objects[ToDoList.ItemIndex]).GetPriority - 1;
end;

procedure TToDoForm.ToDoListDblClick(Sender: TObject);
{ when double clicked, load the current item's string into the InputLine
  ToDoListClick will execute also }
begin
  InputLine.Text := ToDoList.Items.Strings[ToDoList.ItemIndex];
end;

{ ---------------------- }
{ Form-level event       }
{ ---------------------- }
procedure TToDoForm.FormCreate(Sender: TObject);
begin
   DateDueEditBox.Text := DateToStr(Date);
   SetChanged( Sender, False );
   { I've used a panel as a reference area. The form
     resizes around the panel, so it should look more
     or less OK at most screen resolutions }
   ClientHeight := Panel1.Height;
   ClientWidth := Panel1.Width;
   CalendarBtn.Height := dateDueEditBox.Height;
   CalendarBtn.Top := dateDueEditBox.Top;
end;

{ ---------------------- }
{ Button clicks          }
{ ---------------------- }
procedure TToDoForm.AddBtnClick(Sender: TObject);
{ add new item to ToDoList }
var
   CurrentItem : ToDoItem;
   NewStr : string;
begin
  NewStr := TrimEnds(InputLine.Text);
  If NewStr = '' Then
     MessageDlg('There is no item to add!', mtInformation,
      [mbOk], 0)
  else
  begin
      { if no date is specified, use Today's date }
    if DateDueEditBox.Text = '' then
     DateDueEditBox.Text := DateToStr(Now);
      { create a new ToDoItem object }
     CurrentItem:= ToDoItem.Create;
     With CurrentItem do
      { set its fields using values on form }
     begin
       Putpriority(RadioGroupPriority.ItemIndex+1);
       PutDateDue(StrToDate(DateDueEditBox.Text));
     end;
     ToDoList.Items.AddObject(NewStr, CurrentItem);
     InputLine.Text := '';
     SetChanged( Sender, true );
  end;
  ActiveControl := InputLine;
  RadioGroupSetSortClick(Sender); { re-sort if necessary }
end;

procedure TToDoForm.DelBtnClick(Sender: TObject);
begin
  if ToDoList.ItemIndex >= 0 then
  begin
     ToDoList.Items.Delete(ToDoList.ItemIndex);
     SetChanged( Sender,true );
  end
  else
    MessageDlg('You must select an item to delete!', mtInformation,
      [mbOk], 0)
end;

procedure TToDoForm.ReplaceBtnClick(Sender: TObject);
begin
  if (TrimEnds(InputLine.Text) = '') then
     MessageDlg('You must enter a new item.', mtInformation,
      [mbOk], 0)
  else if (ToDoList.ItemIndex < 0) then
     MessageDlg('You must select the item you wish to replace.', mtInformation,
      [mbOk], 0)
  else
  begin
     DelBtnClick(Sender);
     AddBtnClick(Sender);
  end
end;

{ ---------------- }
{ Mouse menu items }
{ ---------------- }
procedure TToDoForm.Add1Click(Sender: TObject);
begin
  AddBtnClicK(Sender);
end;

procedure TToDoForm.Delete1Click(Sender: TObject);
begin
  DelBtnClick(Sender);
end;

procedure TToDoForm.Replace1Click(Sender: TObject);
begin
  ReplaceBtnClick(Sender);
end;

procedure TToDoForm.Name1Click(Sender: TObject);
begin
  RadioGroupSetSort.ItemIndex := 1;
  RadioGroupSetSortClick(Sender);
end;

procedure TToDoForm.Priority1Click(Sender: TObject);
begin
  RadioGroupSetSort.ItemIndex := 2;
  RadioGroupSetSortClick(Sender);
end;

procedure TToDoForm.Date1Click(Sender: TObject);
begin
  RadioGroupSetSort.ItemIndex := 3;
  RadioGroupSetSortClick(Sender);
end;

procedure TToDoForm.Unsorted1Click(Sender: TObject);
begin
  RadioGroupSetSort.ItemIndex := 0;
  RadioGroupSetSortClick(Sender);
end;

procedure TToDoForm.CalendarBtnClick(Sender: TObject);
begin
  CalForm.ShowModal;
end;

procedure TToDoForm.ExitBtnClick(Sender: TObject);
begin
  ExitMnuClick(Sender);
end;

end.